home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / programm / prog_a2m / dblscrll / dblscrll.lst < prev   
File List  |  1995-05-02  |  2KB  |  86 lines

  1. '
  2. ' Demonstration of TOS 1.4 (and above) mouse doubling bug
  3. ' By Charles F. Johnson
  4. '
  5. DEFINT "a-z"
  6. DIM message_buffer&(7),x(4),y(4)
  7. adr_mes=V:message_buffer&(0)
  8. ABSOLUTE word0&,adr_mes
  9. ABSOLUTE x&,adr_mes+8
  10. ABSOLUTE y&,adr_mes+10
  11. ABSOLUTE w&,adr_mes+12
  12. ABSOLUTE h&,adr_mes+14
  13. '
  14. ~WIND_GET(0,5,x0,y0,w0,h0)
  15. fill.screen(x0,y0,x0+w0-1,y0+h0-1)
  16. title$=" Click arrows to demonstrate "+CHR$(0)
  17. info$=" Click 'Full' button - Timer is now ON"+CHR$(0)
  18. handle&=WIND_CREATE(&X11010111,0,19,639,380)
  19. adr_title=V:title$
  20. ~WIND_SET(handle&,2,CARD(SWAP(adr_title)),CARD(adr_title),0,0)
  21. set.info
  22. ~WIND_OPEN(handle&,200,80,360,200)
  23. ~WIND_GET(handle&,4,wx&,wy&,ww&,wh&)
  24. BOUNDARY 0
  25. PBOX wx&,wy&,wx&+ww&-1,wy&+wh&-1
  26. BOUNDARY 1
  27. events&=&X110001       ! Initialize to timer, message, and keyboard events
  28. finish!=FALSE
  29. timeval=0
  30. '
  31. REPEAT
  32.   '
  33.   ' We're using a timer length of zero.  Increasing the timer value
  34.   ' does somewhat alleviate the doubling up problem, but it still
  35.   ' happens occasionally.
  36.   '
  37.   event=EVNT_MULTI(events&,0,0,0,0,0,0,0,0,0,0,0,0,0,adr_mes,timeval,d,d,d,d,key,d)
  38.   IF BTST(event,0)
  39.     SELECT BYTE(key)
  40.     CASE 27
  41.       finish!=TRUE
  42.     ENDSELECT
  43.   ELSE IF BTST(event,4)
  44.     SELECT word0&
  45.     CASE 22          ! WM_CLOSED - closed
  46.       finish!=TRUE
  47.     CASE 23          ! WM_FULLED - full size
  48.       IF events&=&X110001
  49.         info$=" Click 'Full' button - Timer is now OFF"+CHR$(0)
  50.         set.info
  51.         events&=&X10001
  52.       ELSE
  53.         info$=" Click 'Full' button - Timer is now ON"+CHR$(0)
  54.         set.info
  55.         events&=&X110001
  56.       ENDIF
  57.       word0&=0
  58.     CASE 24            ! WM_ARROWED
  59.       ~WIND_UPDATE(1)
  60.       PRINT "Arrow message received."
  61.       IF CRSLIN>=25
  62.         fill.screen(x0,y0,x0+184,y0+h0-1)
  63.       ENDIF
  64.       ~WIND_UPDATE(0)
  65.       word0&=0
  66.     ENDSELECT
  67.   ENDIF
  68. UNTIL finish!
  69. ~WIND_CLOSE(handle&)
  70. ~WIND_DELETE(handle&)
  71. END
  72. '
  73. PROCEDURE fill.screen(x1,y1,x2,y2)
  74.   DEFFILL 1,2,4
  75.   BOUNDARY 0
  76.   PBOX x1,y1,x2,y2
  77.   BOUNDARY 1
  78.   DEFFILL 1,0
  79.   PRINT AT(1,1);"";
  80. RETURN
  81. '
  82. PROCEDURE set.info
  83.   adr_info=V:info$
  84.   ~WIND_SET(handle&,3,CARD(SWAP(adr_info)),CARD(adr_info),0,0)
  85. RETURN
  86.